komunikowanie danych

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(ggthemes)
library(here)

## here() starts at /Users/golemxiv/Documents/dydaktyka/wizualizacjaR

Dane

Z użyciem here::here by uniknąć problemów z relatywnymi i absolutnymi ścieżkami

panteon <- read_csv(here("podstawy", "panteon_s.csv"))

## Rows: 11341 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): name, countryName, countryCode3, continentName, gender, industry, d...
## dbl (6): LAT, LON, birthyear, L_star, HPI, AverageViews
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Na wszelki wypadek, gdybyśmy mieli poblemy z here dane z internetu:

panteon <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/main/podstawy/panteon_s.csv")

## Rows: 11341 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): name, countryName, countryCode3, continentName, gender, industry, d...
## dbl (6): LAT, LON, birthyear, L_star, HPI, AverageViews
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

gdp <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/refs/heads/main/komunikowanie%20danych/gdp_percap.csv")

## Rows: 255 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): country_name, country_code
## dbl (1): gdp_percap
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

pop <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/refs/heads/main/komunikowanie%20danych/pop_total.csv")

## Rows: 265 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): country_name, country_code
## dbl (1): pop_total
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Dokończenie z zajęć o przekształcaniu danych: join i mutate

Stworzymy wykres na podstawie połączenia danych panteon i danych banku świadowego o gdp.percap

panteon_c <- panteon %>%
  filter(!is.na(continentName), continentName != "Unknown")

panteon_c <- panteon %>%
  filter(!is.na(continentName), continentName != "Unknown") %>%
  group_by(countryCode3, continentName) %>%
  summarise(sławni = n())  %>%
  ungroup()

## `summarise()` has grouped output by 'countryCode3'. You can override using the
## `.groups` argument.

panteon_d <- panteon_c %>%
  left_join(gdp)

panteon_d <- panteon_c %>%
  left_join(gdp, by = c("countryCode3" = "country_code"))

panteon_d %>%
  ggplot(aes(x = gdp_percap, y = sławni)) +
  geom_jitter() +
  geom_smooth() +
  facet_wrap(~continentName)

## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

## Warning: Removed 13 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning: Removed 13 rows containing missing values or values outside the scale range
## (`geom_point()`).

panteon_d %>%
  ggplot(aes(x = gdp_percap, y = sławni)) +
  scale_x_log10() +
  scale_y_log10() +
  geom_jitter() +
  geom_smooth() +
  facet_wrap(~continentName)

## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

## Warning: Removed 13 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning: Removed 13 rows containing missing values or values outside the scale range
## (`geom_point()`).

Zadanie:

Stwórzmy wykres porównujący liczbę celebrytów per capita w danym kraju z pkb per capita w danym kraju na podstawie danych panteon, gdp i pop,

podpowiedź: użyjmy left_join i mutate

panteon_e <- panteon_c %>%
  left_join(pop, by = c("countryCode3" = "country_code")) %>%
  mutate(sławni_percap = sławni/pop_total*10000)

panteon_e %>%
  ggplot(aes(x = sławni, y = pop_total)) +
  scale_x_log10() +
  scale_y_log10() +
  geom_jitter() +
  geom_smooth() +
  facet_wrap(~continentName)

## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

## Warning: Removed 4 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at -0.0099782

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 0.4871

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 0.22764

## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## -0.0099782

## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 0.4871

## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 0

## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 0.22764

## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).

str(pop)

## spc_tbl_ [265 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ country_name: chr [1:265] "Aruba" "Africa Eastern and Southern" "Afghanistan" "Africa Western and Central" ...
##  $ country_code: chr [1:265] "ABW" "AFE" "AFG" "AFW" ...
##  $ pop_total   : num [1:265] 1.07e+05 7.51e+08 4.15e+07 5.09e+08 3.67e+07 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   country_name = col_character(),
##   ..   country_code = col_character(),
##   ..   pop_total = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

Legendy i funkcja guide

p <- ggplot(panteon_c, aes(x = reorder(continentName, sławni), 
                            y = sławni, 
                            color = continentName)) +
  scale_y_log10() +
  geom_boxplot() +
  geom_jitter() 

p

 p <- ggplot(panteon_c, aes(x = reorder(continentName, sławni, FUN = median), 
                            y = sławni, 
                            color = continentName,
                            fill = continentName)) +
  scale_y_log10() +
  geom_boxplot()
p

p + theme(legend.position="left", legend.title.position = "bottom")

Usuwanie legendy

p + theme(legend.position="none",
        )

Zmiana kolejności etykiet w legendzie z użyciem faktorów

Zmiana poprzez zmianę kolejności faktorów

Zmiana kolejności etykiet w legendzie z użyciem guides

Żeby zmienić kolejność w legendzie trzeba dodać guides() i guide_legend() do geom_point(). W

p +
  guides(color = guide_legend(reverse = TRUE),
         fill = guide_legend(reverse = TRUE)) # 

narysujemy wykres według płci,AverageViews

panteon %>%
  ggplot() +
  geom_boxplot(aes(x = reorder(gender,AverageViews),
                   y = AverageViews)) +
  scale_y_log10(breaks = c(100, 10000, 1000000),
                labels = c("", "10 tys.", "1 mln.")) +
  scale_x_discrete(labels = c("mężczyzna", "kobieta")) +
  labs(x = "płeć",
       title = "boxplot") +
  theme(plot.title = element_text(hjust = 0)) +
  theme_wsj()

# usuwa legendę koloru wypełnienia

p + scale_color_manual(values=c('pink','steelblue','#56B4E9', "red", "135", "gray56"), 
                       guide = "none") #

Zmiany układu legendy np keywidth czy label

 p + guides(
  color = guide_legend(
    reverse = TRUE, 
    title.position = "bottom", 
    label.position = "bottom",
    keywidth = 6,
    nrow = 3
  )
)

etykiety <- c("Afryka", "Azja", "Europa", "Ameryka Północna", "Oceania", "Ameryka Południowa")

 t <- ggplot(panteon_c, aes(x = continentName, 
                            y = sławni, 
                            color = continentName)) +
  #scale_color_manual(values=c('pink','steelblue','#56B4E9', "red", "135", "gray56"))+
  scale_y_log10() +
  scale_x_discrete(labels = etykiety) +
  geom_boxplot()

Ręczna modyfikacja legendy

t + 
  scale_color_manual(
    name = "Nowy tytuł legendy",  # Zmiana tytułu legendy
    values = c('pink','steelblue','#56B4E9', "red", "135", "gray56"),  # Ręczne ustawienie kolorów
    labels = etykiety) +
  guides(
    color = guide_legend(
      reverse = TRUE, 
      title.position = "bottom", 
      label.position = "bottom",
      keywidth = 6,
      nrow = 3
    )
  )

Skale

panteon %>%
  ggplot() +
  geom_boxplot(aes(x = gender, 
                   y = AverageViews)) +
  scale_y_log10()

panteon %>%
  ggplot() +
  geom_histogram(aes(AverageViews))

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Można doknowywać przekształceeń za pomocą skali

p1 <- panteon %>%
  ggplot() +
  geom_boxplot(aes(x = reorder(gender, AverageViews), y = AverageViews)) +
  scale_y_log10()

p1

Można ręcznie ustalać liczbę znaczników na skali

p1 + 
  labs(x = "płeć",
       y = "wyświetlenia",
       title = "Rozkład wyświetleń\nwedług płci") +
  scale_x_discrete(labels = c("kobieta", "mężczyzna")) +
  scale_y_log10(breaks = c(0, 100000, 1000000), 
                labels = c("0", "100 tys.", "1 mln.")) +
  theme_bw()

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

#install.packages("ggthemes")
library(ggthemes)

panteon %>%
  ggplot() +
  geom_boxplot(aes(x = gender, y = AverageViews)) +
  scale_y_log10(breaks = c(0, 100000, 1000000), labels = c("", "100 tys.", "1 mln")) +
  scale_x_discrete(labels = c("kobiety", "mężczyźni")) +
  labs(y = "średnia wyświetleń",
       x = "",
       title = "Biografie kobiet są średnio częściej wyświetlane niż biografie mężczyzn",
       subtitle = "Rozkład średniej wyświetleń biografii postaci z Panteon 1.0",
       caption = "Źródło: Panteon 1.0")

w1 <- panteon %>%
  ggplot() +
  geom_boxplot(aes(x = gender, y = AverageViews)) +
  scale_y_log10(breaks = c(0, 100000, 1000000), labels = c("", "100 tys.", "1 mln")) +
  scale_x_discrete(labels = c("kobiety", "mężczyźni")) +
  labs(y = "średnia wyświetleń",
       x = "",
       title = "Biografie kobiet są średnio częściej wyświetlane niż biografie mężczyzn",
       subtitle = "Rozkład średniej wyświetleń biografii postaci z Panteon 1.0")

w1

Adnotacje geom_text i geom_label

ggplot(mpg, aes(x = hwy, y = cty)) +
  geom_point() +
  geom_text(aes(label = manufacturer))

ggplot(panteon, aes(x = HPI, y = L_star)) +
  geom_point() +
  geom_text(aes(label = name))

polki <- panteon %>%
  filter(countryCode3 == "POL" & gender == "Female")

panteon %>%
  filter(countryCode3 == "POL" & gender == "Female") %>%
  ggplot(aes(x = L_star, y = HPI, size = AverageViews)) +
  geom_point(aes(size = AverageViews)) +
  geom_point(data = polki %>% filter(name == "Doda"), color= "red") +
  geom_label(aes(label = name), nudge_y = 5, hjust = 1.5, vjust = 1.5)

Zastosowanie funkcji z biblioteki ggrepel

#install.packages("ggrepel")
library(ggrepel)

panteon %>%
  filter(countryCode3 == "POL" & gender == "Female") %>%
  ggplot(aes(x = L_star, y = HPI)) +
  geom_point(aes(size = AverageViews)) +
  geom_text_repel(aes(label = name))

Adnotacja funkcją annotate

panteon %>%
  filter(countryCode3 == "POL" & gender == "Female") %>%
  ggplot(aes(x = L_star, y = HPI)) +
  geom_point(aes(size = AverageViews)) +
  geom_text_repel(aes(label = name)) +
  annotate(geom = "text", 
           x=8, 
           y=30, 
           label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II") #cudzysłów wewnętrz cudzysłowu musi się różnić od zewnętrznego

panteon %>%
  filter(countryCode3 == "POL" & gender == "Female") %>%
  ggplot(aes(x = L_star, y = HPI)) +
  geom_point(aes(size = AverageViews)) +
  geom_text_repel(aes(label = name)) +
  annotate(geom = "text", x=8, y=30, label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II",) +
  
  annotate(geom = "rect", xmin = 7.5, xmax = 11, ymin = 27, ymax = 29, fill = "red", alpha = 0.2) #adnotacja w postaci prostokąta

panteon %>%
  filter(countryCode3 == "POL" & gender == "Female") %>%
  ggplot(aes(x = L_star, y = HPI)) +
  geom_point(aes(size = AverageViews)) +
  geom_text_repel(aes(label = name)) +
  annotate(geom = "text", x = 5, y = 30, label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II") +
  geom_segment(aes(x = 6, xend = 9, y = 30, yend = 28),
               arrow = arrow(type = "closed", length = unit(0.2, "inches")))  # Dodanie strzałki

## Warning in geom_segment(aes(x = 6, xend = 9, y = 30, yend = 28), arrow = arrow(type = "closed", : All aesthetics have length 1, but the data has 17 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

Filtrowanie danych wewnątrz geometrii

polki <- panteon %>%
  filter(countryCode3 == "POL" & gender == "Female")

ggplot(polki, aes(x = L_star, y = HPI)) +
  geom_point(aes(size = AverageViews)) +
  geom_text_repel(data = polki %>% filter(AverageViews > mean(polki$AverageViews)), aes(label = name), nudge_y = 1.5) +
  annotate(geom = "text", x=8, y=30, label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II",) +
  
  annotate(geom = "rect", xmin = 7.5, xmax = 11, ymin = 27, ymax = 29, fill = "red", alpha = 0.2) +
  guides(size = "none")

linie

panteon %>%
  filter(countryCode3 == "POL" & gender == "Female") %>%
  ggplot(aes(x = L_star, y = HPI)) +
  geom_point(aes(size = AverageViews)) +
  geom_text_repel(aes(label = name)) +
  geom_vline(xintercept = mean(panteon$L_star)) +
  geom_hline(yintercept = mean(panteon$HPI))

Linia ze strzałką

panteon %>%
  filter(countryCode3 == "POL" & gender == "Female") %>%
  ggplot(aes(x = L_star, y = HPI)) +
  geom_point(aes(size = AverageViews)) +
  geom_text_repel(aes(label = name)) +
  annotate(geom = "text", 
           x=8, 
           y=30, 
           label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II") +
  geom_segment(aes(x = 8, xend = 9.4 , 
                   y= 29,
                   yend = 27.9),
    arrow = arrow(length = unit(0.1,"cm"))) +
  geom_curve(aes(x = 8, xend = 9.4 , 
                   y= 29,
                   yend = 27.9),
    arrow = arrow(length = unit(0.1,"cm")))

## Warning in geom_segment(aes(x = 8, xend = 9.4, y = 29, yend = 27.9), arrow = arrow(length = unit(0.1, : All aesthetics have length 1, but the data has 17 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

## Warning in geom_curve(aes(x = 8, xend = 9.4, y = 29, yend = 27.9), arrow = arrow(length = unit(0.1, : All aesthetics have length 1, but the data has 17 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

Kolory

Sposoby operowania kolorami w R

• rgb
• kody
• numery
• nazwy
• biblioteki i palety
• gradienty
• skale ręczne

więcej na ten temat na ciekawej stronie R Graph Gallery

RGB i kody

• kolorymetr i rgb

?rgb()

kolor1 <- rgb(144, 26, 40, maxColorValue = 255) # domyślnie jest na skali intensywności 0-1 dlatego przy skali 0-255 trzeba ustalić argument maxColorValue na 255

kolor2 <- rgb(200, 131, 84, maxColorValue = 255)
  
print(kolor1)

## [1] "#901A28"

print(kolor2)

## [1] "#C88354"

ggplot(mtcars, aes(x=drat)) +
  geom_density(color= kolor2,
               fill=kolor1, 
               linewidth=2 ) 

Bezpośrednie podawanie kolorów

ggplot(mtcars, aes(x=drat)) + 
  geom_density( color = "#C88354", 
                fill="#901A28", 
                linewidth=2 )

Powyższy przykłąd to zapis zapis heksadecymalny, który jest często używany w grafice komputerowej i web designie. Składa się on z sześciu znaków, przy czym każdy parzysty zestaw dwóch znaków reprezentuje jedną z trzech podstawowych składowych koloru: czerwony (R), zielony (G) i niebieski (B). Każdy zestaw może przyjmować wartość od 00 do FF w systemie szesnastkowym, co odpowiada wartościom od 0 do 255 w systemie dziesiętnym.

Funkcja rgb jako wartość argumentu mapującego kolor

ggplot(mtcars, aes(x=drat)) + 
  geom_density(color=(rgb(200, 131, 84, 
                          maxColorValue = 255)), 
               fill= (rgb(63, 74, 84, 
                          maxColorValue = 255)), linewidth=2)

Nazwy kolorów

#20 pierwszych nazw kolrów
r_color <- colors()
head(r_color, 20)

##  [1] "white"         "aliceblue"     "antiquewhite"  "antiquewhite1"
##  [5] "antiquewhite2" "antiquewhite3" "antiquewhite4" "aquamarine"   
##  [9] "aquamarine1"   "aquamarine2"   "aquamarine3"   "aquamarine4"  
## [13] "azure"         "azure1"        "azure2"        "azure3"       
## [17] "azure4"        "beige"         "bisque"        "bisque1"

• niektóre nazwy kolorów
• kod na stronie R Graph Gallery

## przykłdowa lista nazw kolorów:

plot(0, 0, type = "n", xlim = c(0, 1), ylim = c(0, 1), axes = FALSE, xlab = "", ylab = "")
# Settings
line <- 25
col <- 5

# Add color background
rect(  
  rep((0:(col - 1)/col),line) ,  
  sort(rep((0:(line - 1)/line),col),decreasing=T),   
  rep((1:col/col),line) , 
  sort(rep((1:line/line),col),decreasing=T),  
  border = "white" , 
  col=colors()[seq(1,line*col)])

# Color names
text(  
  rep((0:(col - 1)/col),line)+0.1 ,  
  sort(rep((0:(line - 1)/line),col),decreasing=T)+0.015 , 
  colors()[seq(1,line*col)]  , 
  cex=0.6)

Wpisywanie nazw kolorów bezpośrednio

ggplot(mtcars, aes(x=drat)) + 
  geom_density(color= "darkorange1", 
               fill= "darkslategray",
               linewidth=2 )

ggplot(mtcars, aes(x=drat)) + 
  geom_density(color= "darkorange1", 
               fill= "darkslategray",
               linewidth=2 ) +
  theme(axis.text.y = element_text(angle = 45))

Numery kolorów

kolor3  = colors()[143] 

Niektóre kolory według numerów

#numery kolorów

par(mar=c(0,0,0,0))
plot(0, 0, type = "n", xlim = c(0, 1), ylim = c(0, 1), axes = FALSE, xlab = "", ylab = "")

# parametry
line <- 31
col <- 21

# Rectangles
rect( rep((0:(col - 1)/col),line) ,  sort(rep((0:(line - 1)/line),col),decreasing=T) , rep((1:col/col),line) , sort(rep((1:line/line),col),decreasing=T),  
      border = "light gray" , col=colors()[seq(1,651)])

# Text
text( rep((0:(col - 1)/col),line)+0.02 ,  sort(rep((0:(line - 1)/line),col),decreasing=T)+0.01 , seq(1,651)  , cex=0.5)

ggplot(mtcars, aes(x=drat)) + 
  geom_density(color= colors()[53],
               fill= colors()[593],
               linewidth=2 )

Rcolorbrewer

#install.packages("RColorBrewer")
library(RColorBrewer) 

Show all the colour schemes available

dev.off()

## null device 
##           1

par(mfrow=c(1,1))
display.brewer.all()

Palety RColorBrewer przyjazne dla osób z zaburzeniami postrrzegania kolorów

display.brewer.all(colorblindFriendly = TRUE)

Scale Viridis

#install.packages("viridis")
library(viridis)

## Loading required package: viridisLite

scale_fill_viridis(discrete = TRUE)

Przykłady

Użyjemy danych ze zbioru ToothGrowth

glimpse(ToothGrowth)

## Rows: 60
## Columns: 3
## $ len  <dbl> 4.2, 11.5, 7.3, 5.8, 6.4, 10.0, 11.2, 11.2, 5.2, 7.0, 16.5, 16.5,…
## $ supp <fct> VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, V…
## $ dose <dbl> 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 1.0, 1.0, 1.0, …

ToothGrowth$dose <- as.factor(ToothGrowth$dose)
mtcars$cyl <- as.factor(mtcars$cyl)

#boxplot
bp <- ggplot(ToothGrowth, aes(x=dose, y=len))

# scatter plot

sp <- ggplot(mtcars, aes(x=wt, y=mpg))

bp + geom_boxplot(fill = "steelblue", color = "red")

Biblioteka paletteer

https://r-graph-gallery.com/color-palette-finder

box plot

sp + geom_point(color = 'darkblue')

bp <- bp + geom_boxplot(aes(fill = dose)) 

sp <- sp + geom_point(aes(color = cyl))

Hue

Jasność (lighteness) (l) i chroma (c, intensity of color) domyślnych kolorów (hue) kolory można modyfikować scale_hue

bp + scale_fill_hue(l=40, c=35) 

# Scatter plot

sp + scale_color_hue(l=40, c=35) 

scale_* manual

bp + scale_fill_manual(values=c("#999999", "#E69F00", "#56B4E9"))

sp + scale_color_manual(values=c("#999999", "#E69F00", "#56B4E9"))

RcolorBrewer

sp + scale_color_brewer(palette="Dark2")

palety z filmów Wesa Andersona

Wymaa instalacji pakietu wesanderson

#install.packages("wesanderson") 

library(wesanderson)

bp + scale_fill_manual(values=wes_palette(n=3, name="GrandBudapest1"))

sp+scale_color_manual(values=wes_palette(n=3, name="GrandBudapest1"))

gradienty

ciągłe skale kolorów

• scale_color_gradient(), scale_fill_gradient() sekwencyjne gradienty między dwoma kolorami

• scale_color_gradient2(), scale_fill_gradient2() dywergentne gradienty

scale_color_gradientn(), scale_fill_gradientn() gradienty między n kolorami

przykłady

sp2 <- ggplot(mtcars, aes(x = wt, y = mpg)) + 
  geom_point(aes(color = qsec)) 


sp2 

# Change the low and high colors

# sekwencyjna
sp2+scale_color_gradient(low="blue", high="red")

# Ddywergentna
mid <- mean(mtcars$qsec) 
sp2 + scale_color_gradient2(midpoint = mid, low = "blue", 
                            mid = "white", 
                            high = "red", 
                            space = "Lab" )

## gradeinty n-kolorów

sp3 <- ggplot(mtcars, aes(x = wt, y = mpg)) + 
  geom_point(aes(color = mpg)) 

sp3

Theme

Za pmoocą funkcji theme_set możemy ustalić parametry wyglądu motywu dla wszystkich kolejnych wykresów

theme_set(theme_bw())

sp3 + theme(legend.position = "bottom")

sp3 +
  theme(plot.title = element_text(size = rel(0.9)),
        plot.subtitle = element_text(size = rel(0.4)))

sp3 +
  theme(plot.title = element_text(size = rel(0.9),
                                  family = "Times",
                                  face = "bold.italic",
                                  colour = "salmon"),
        plot.subtitle = element_text(size = rel(0.4)))

Przykład z wykresem pasków klimatycznych

Dodatkowe biblioteki, doinstalujmy jeśli nie mamy i wczytajmy

library(scales)

## 
## Attaching package: 'scales'

## The following object is masked from 'package:viridis':
## 
##     viridis_pal

## The following object is masked from 'package:purrr':
## 
##     discard

## The following object is masked from 'package:readr':
## 
##     col_factor

library(RColorBrewer)

Dane:

# dane dla stacji Okęcie od 1880 roku

temp_okęcie <- read_csv(here("komunikowanie danych", "okecie_temp.csv"))

## Rows: 145 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl  (3): YEAR, ta, td
## date (1): date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Wykres średnich temperatur Okęcie

ustawianie skali z wykorzystaniem RColorBrewer

col_strip <- brewer.pal(11, "RdBu")

ggplot(temp_okęcie,
             aes(x = date, y = 1, fill = ta))+
        geom_tile() +
           scale_x_date(date_breaks = "10 years",
                     date_labels = "%Y",
                     expand = c(0, 0))+
           scale_y_continuous(expand = c(0, 0)) +
           scale_fill_gradientn(colors = rev(col_strip)) +
             guides(fill = guide_colorbar(barwidth = 1)) +
            labs(title = "Okęcie 1880-2024",
                caption = "Dane: GISS Surface Temperature Analysis") +
              theme_minimal()

ggsave("ocieplenie_okęcie.png", width=8, height=4.5)

ustawianie motywu

Ustawimy motyw

theme_strip <- theme_minimal()+
                 theme(axis.text.y = element_blank(),
                       axis.line.y = element_blank(),
                       axis.title = element_blank(),
                       panel.grid.major = element_blank(),
                       legend.title = element_blank(),
                       axis.text.x = element_text(vjust = 3),
                       panel.grid.minor = element_blank(),
                        plot.title = element_text(size = 14, face = "bold")
                       )

o <- ggplot(temp_okęcie,
             aes(x = YEAR, y = 1, fill = ta)) +
        geom_tile() +
           scale_x_continuous(breaks=seq(1890, 2020, 30))+
           scale_y_continuous(expand = c(0, 0)) +
           scale_fill_gradientn(colors = rev(col_strip)) +
             guides(fill = "none") +
            labs(title = "Okęcie 1880-2024",
                caption = "Dane: GISS Surface Temperature Analysis") +
              theme_strip

ggplot(temp_okęcie,
             aes(x = date, y = 1, fill = ta)) +
        geom_tile() +
           scale_x_date(date_breaks = "20 years",
                     date_labels = "%Y",
                     expand = c(0, 0))+
           scale_y_continuous(expand = c(0, 0)) +
           scale_fill_gradientn(colors = rev(col_strip)) +
             guides(fill = "none") +
            labs(title = "Okęcie 1880-2024",
                caption = "Dane: GISS Surface Temperature Analysis") +
              theme_strip

Inna wersja wykresu z danych dotczących Okęcia, tym razem zmiana w stosunku do poprzedniego roku

(o <- temp_okęcie %>%
  ggplot(aes(x = YEAR, y = 1, fill = td)) +
  geom_tile(show.legend = FALSE) +
  scale_fill_stepsn(colors=c("#08306B", "white", "#67000D"),
                    values = rescale(c(min(temp_okęcie$td, na.rm = TRUE), 0, max(temp_okęcie$td, na.rm = TRUE))),
                    n.breaks = 12) +
  coord_cartesian(expand=FALSE) +
  scale_x_continuous(breaks=seq(1890, 2020, 30)) +
  #labs(title= glue("Global temperature change ({min(t_data$year)}-{max(t_data$year)})")) +
  theme_void() +
  theme(
    axis.text.x = element_text(color="white",
                               margin =margin(t=5, b=10, unit="pt")),
    plot.title = element_text(color="white",
                               margin =margin(b=5, t=10, unit="pt"),
                              hjust= 0.05),
    plot.background = element_rect(fill="black")
))

Szybki sposób na wykres interaktwny

#install.packages("plotly")

plotly::ggplotly(o)

Co po zajęciach?

więcej o kolorach

Co przed kolejnymi zajęciami

o wykresach interaktywnych w plotly

ściągawka RMarkdown

Zadanie domowe

Stwórzmy wykres podobny do tego:

pay gap

na podstawie danych:

pay_gap <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/main/case%20studies%20/pay_gap_uk.csv")

## Rows: 81 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): occupation, category, pay_gap_as_a_percentage
## dbl (3): women_average_annual_salary, men_average_annual_salary, pay_gap
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Powyższy wykres jest interaktywny. W odpowiedzi na zadanie wystarczy wykres statyczny. Uporządkujmy zawody według różnicy pensji. Możemy pominąć główne kategorie a zostać przy konkretnych zawodach. Postarajmy sięzachować kolory. Wskazówki:  - użyjmy geom_segment i geom_point, - można zwiększyć interaktywność wykresu, używając plotly::ggplotly i estetyki text by móc pokazywać wysokość średniej pensji w chmurce, tak jak w wykresie z linku - używając różnych ustawień i funkcji wewnątrz theme_ możemy zredukować liczbę linii siatki i modyfikować inne elementy, możliwie upodobniając nasz wykres do wzoru

P.S.

#### Poniższy kod wyłącza notację naukową

options(scipen =999)